home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor2
/
laplace.src
< prev
next >
Wrap
Text File
|
1994-01-04
|
5KB
|
139 lines
%%HP: T(3)A(D)F(.);
@ LAPLACE by John Meissner
DIR
L2EQ
\<< DUP ROT ROT PF SWAP \->QUAD 0 0 0 0 0 1
\-> numer denom count a b r1 r2 dups
\<< denom SIZE 1
FOR count
IF count denom SIZE <
THEN
IF denom count GETI ROT ROT GET ==
THEN dups 1 + 'dups' STO
ELSE 1 'dups' STO
END
END denom count GET
IF DUP TYPE 5 ==
THEN LIST\-> DROP
IF OVER
THEN 2 \->LIST { 1 0 0 } PADD RT DROP C\->R 'r2' STO
NEG 'r1' STO numer count GET 1 r1 2 \->LIST PDIV
LIST\-> DROP 'b' STO LIST\-> DROP 'a' STO
'a*EXP(-r1*T)*COS(r2*T)*u(T)+b/r2*EXP(-r1*T)*SIN(r2*T)*u(T)'
EVAL
ELSE \v/ 'r2' STO 'r1' STO numer count GET LIST\-> DROP
'b' STO 'a' STO
IF dups 1 >
THEN
'a*T*COS(r2*T)*u(T)+b/(2*r2)*T*SIN(r2*T)*u(T)' EVAL
ELSE
'a*COS(r2*T)*u(T)+b/r2*SIN(r2*T)*u(T)' EVAL
END
END
ELSE 'r1' STO numer count GET 'a' STO
IF r1
THEN
IF dups 1 >
THEN
'a/(dups-1)!*T^(dups-1)*EXP(-r1*T)*u(T)' EVAL
ELSE
'a*EXP(-r1*T)*u(T)' EVAL
END
ELSE
IF dups 1 >
THEN
'a/(dups-1)!*T^(dups-1)*u(T)' EVAL
ELSE
'a*u(T)' EVAL
END
END
END
IF count denom SIZE <
THEN +
END -1
STEP
\>>
\>>
\->QUAD
\<< DUP SIZE 0 0 0 0
\<<
IF DUP IM NOT
THEN RE
END
\>> \-> numer denom count a b r1 r2 reduce
\<<
WHILE count 1 >
REPEAT denom count 1 - GETI 'r1' STO GET 'r2' STO
IF r1 IM 0 \=/ r1 CONJ r2 == AND
THEN numer count 1 - GETI 'a' STO GET 'b' STO
denom count 1 - r1 r2 + NEG reduce EVAL r1 r2 * reduce EVAL
2 \->LIST PUT LIST\-> DUP count - 2 + ROLL DROP 1 - \->LIST
'denom' STO numer count 1 - a b + reduce EVAL a r2 * b r1 *
+ NEG reduce EVAL 2 \->LIST PUT LIST\-> DUP count - 2 + ROLL
DROP 1 - \->LIST 'numer' STO count 2 - 'count' STO
ELSE denom count DUP2 GET NEG PUT 'denom' STO numer count DUP2
GET reduce EVAL PUT 'numer' STO count 1 - 'count' STO
END
END numer denom
IF count
THEN SWAP 1 DUP2 GET reduce EVAL PUT SWAP 1 DUP2 GET NEG PUT
END
\>>
\>>
\->L
\<<
{ '&k*(T-&a)^&n*u(T-&a)' '&k*&n!/S^(&n+1)*EXP(-&a*S)' } \|vMATCH DROP
{ '&k*u(T-&a)' '&k*u(T)*EXP(-&a*S)' } \|vMATCH DROP
{ '&k*r(T-&a)' '&k*r(T)*EXP(-&a*S)' } \|vMATCH DROP
{ '&k*d(T-&a)' '&k*d(T)*EXP(-&a*S)' } \|vMATCH DROP
{ '&k*d(T)' &k } \|vMATCH DROP
{ '&k*r(T)' '&k/S^2' } \|vMATCH DROP
{ '&k*T^&n*u(T)' '&k*&n!/S^(&n+1)' } \|vMATCH DROP
{ '&k*T^&n*EXP(&a*T)*u(T)' '&k*&n!/(S-&a)^(&n+1)' } \|vMATCH DROP
{ '&k*EXP(&a*T)*COS(&\Gw*T)*u(T)' '&k*(S-&a)/((S-&a)^2+&\Gw^2)' }
\|vMATCH DROP
{ '&k*EXP(&a*T)*SIN(&\Gw*T)*u(T)' '&k*&\Gw/((S-&a)^2+&\Gw^2)' }
\|vMATCH DROP
{ '&k*T*COS(&\Gw*T)*u(T)' '&k*(S^2-&\Gw^2)/(S^2+&\Gw^2)^2' }
\|vMATCH DROP
{ '&k*T*SIN(&\Gw*T)*u(T)' '&k/(2*&\Gw)*S/(S^2+&\Gw)^2' } \|vMATCH DROP
{ '&k*COS(&\Gw*T+&\Gh)*u(T)'
'&k*(S*COS(&\Gh)-&\Gw*SIN(&\Gh))/(S^2+&\Gw^2)' } \|vMATCH DROP
{ '&k*SIN(&\Gw*T+&\Gh)*u(T)'
'&k*(S*SIN(&\Gh)+&\Gw*COS(&\Gh))/(S^2+&\Gw^2)' } \|vMATCH DROP
{ '&k*COS(&\Gw*T)*u(T)' '&k*S/(S^2+&\Gw^2)' } \|vMATCH DROP
{ '&k*SIN(&\Gw*T)*u(T)' '&k*&\Gw/(S^2+&\Gw^2)' } \|vMATCH DROP
{ '&k*(EXP(&\Ga*T)-EXP(&\Gg*T))*u(T)' '&k/((S-&\Ga)*(S-&\Gg))' }
\|vMATCH DROP
{ '&k*EXP(&a*T)*u(T)' '&k/(S-&a)'} \|vMATCH DROP
{ '&k*u(T)' '&k/S' } \|vMATCH DROP
\>>
L\->
\<<
{ '&k/S' '&k*u(T)' } \|vMATCH DROP
{ '&k/(S+&a)' '&k*EXP(-&a*T)*u(T)' } \|vMATCH DROP
{ '&k/S^2' '&k*r(T)' } \|vMATCH DROP
{ '&k/S^&n' '&k/(&n-1)!*T^(&n-1)*u(T)' } \|vMATCH DROP
{ '&k/(S+&a)^&n' '&k/(&n-1)!*T^(&n-1)*EXP(-&a*T)*u(T)' } \|vMATCH DROP
{ '&k/S^&n*EXP(&a*S)' '&k/(&n-1)!*(T-&a)^(&n-1)*u(T-&a)' } \|vMATCH DROP
{ '&k*(S+&a)/((S+&a)^2+&\Gw)' '&k*EXP(-&a*T)*COS(\v/&\Gw*T)*u(T)' }
\|vMATCH DROP
{ '&k/((S+&a)^2+&\Gw)' '&k/\v/&\Gw*EXP(-&a*T)*SIN(\v/&\Gw*T)*u(T)' }
\|vMATCH DROP
{ '&k*(S^2-&\Gw)/(S^2+&\Gw)^2' '&k*T*COS(\v/&\Gw*T)*u(T)' }
\|vMATCH DROP
{ '&k*S/(S^2+&\Gw)^2' '&k/(2*\v/&\Gw)*T*SIN(\v/&\Gw*T)*u(T)' }
\|vMATCH DROP
{ '&k*(S*COS(&\Gh)-&\Gw*SIN(&\Gh))/(S^2+&\Gr)'
'&k*COS(&\Gw*T+&\Gh)*u(T)' } \|vMATCH DROP
{ '&k*(S*SIN(&\Gh)+&\Gw*COS(&\Gh))/(S^2+&\Gr)'
'&k*SIN(&\Gw*T+&\Gh)*u(T)' } \|vMATCH DROP
{ '&k*S/(S^2+&\Gw)' '&k*COS(\v/&\Gw*T)*u(T)' } \|vMATCH DROP
{ '&k/(S^2+&\Gw)' '&k/\v/&\Gw*SIN(\v/&\Gw*T)*u(T)' } \|vMATCH DROP
{ '&k/((S+&\Ga)*(S+&\Gg))'
'&k/(&\Gg-&\Ga)*(EXP(-&\Ga*T)-EXP(-&\Gg*T))*u(T)' } \|vMATCH DROP
{ '&k*&f(T)*EXP(&a*S)' '&k*&f(T+&a)' } \|vMATCH DROP
{ '&k*EXP(&a*S)' '&k*d(T+&a)' } \|vMATCH DROP
\>>
END